home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / advbas40.arc / COMBLINE.BAS < prev    next >
Encoding:
BASIC Source File  |  1987-05-20  |  4.9 KB  |  161 lines
  1. 10   CLEAR
  2.      CLS
  3.      OPTION BASE 1
  4.      DEFINT A-Z
  5.      DIM LN!(1001)     ' handle 1,000 referenced lines, maximum
  6.      PRINT"Combline 1.3 -- Basic Utility to Combine Lines"
  7.      PRINT: PRINT
  8. 1010 PRINT
  9.      INPUT"File to combline (? for directory) ";FIL$
  10.      IF FIL$="" THEN END
  11.      IF FIL$="?" THEN FILES"*.BAS": GOTO 1010
  12.      T=INSTR(FIL$,".")
  13.      IF T THEN FIL$=LEFT$(FIL$,T) ELSE FIL$=FIL$+"."
  14.      CALL UPCASE(FIL$)
  15.      CALL EXIST(FIL$+"BAS"+CHR$(0),FILEXISTS)
  16.      IF FILEXISTS=0 THEN PRINT"Missing file ";FIL$;"BAS": GOTO 1010
  17.      CALL EXIST(FIL$+"ASC"+CHR$(0),FILEXISTS)
  18.      IF FILEXISTS=0 THEN PRINT"Missing file ";FIL$;"ASC": GOTO 1010
  19.      OPEN"I",1,FIL$+"BAS"
  20.      A$=INPUT$(1,1)
  21.      CLOSE
  22.      IF A$<>CHR$(255) THEN _
  23.         PRINT FIL$;"BAS is not a tokenized BASIC file.": GOTO 1010
  24.  
  25.      OPEN"R",1,FIL$+"BAS"
  26.      FIELD 1,128 AS REC$
  27.      GET#1,1
  28.      A$=REC$
  29.      CLS
  30.      PRINT"CombLining BASIC file ";FIL$
  31.      PRINT: PRINT
  32.      PRINT"Scanning line";
  33. 1110 IF MID$(A$,2,2)=STRING$(2,0) THEN 1340           ' end of program
  34.      LN$=MID$(A$,4,2)                                 ' get line number
  35.      LN!=CVI(LN$)                                     ' calculate line number
  36.      A$=MID$(A$,6)                                    ' skip line number
  37.      IF LN!<0 THEN LN!=LN!+65536!                     ' make line # unsigned
  38.      LOCATE 4,14
  39.      PRINT LN!;
  40. 1130 IF LEN(A$)<128 AND NOT EOF(1) THEN GET#1: A$=A$+REC$
  41.      C=ASC(A$)
  42.      IF C=0 THEN 1110                                 ' end of line
  43.      IF C=14 THEN 1240                                ' line number
  44.      IF C=34 THEN A$=MID$(A$,2): GOTO 1180            ' quotation mark
  45.      IF C=132 OR C=143 THEN A$=MID$(A$,2): GOTO 1200  ' DATA, REM
  46.      L=2                                              ' normal values
  47.      IF C=15 OR C>249 THEN L=3 _                      ' byte, misc func/cmds
  48.      ELSE IF C=11 OR C=12 OR C=28 THEN L=4 _          ' integer
  49.      ELSE IF C=29 THEN L=6 _                          ' single precision
  50.      ELSE IF C=31 THEN L=10                           ' double precision
  51.      A$=MID$(A$,L)
  52.      GOTO 1130
  53.  
  54. '    scan to closing quotation mark or end of line is reached
  55. 1180 IF LEN(A$)<128 AND NOT EOF(1) THEN GET#1: A$=A$+REC$
  56.      C=ASC(A$)
  57.      IF C=0 THEN 1110
  58.      A$=MID$(A$,2)
  59.      IF C=34 THEN 1130
  60.      GOTO 1180
  61.  
  62. '    scan til end of line is reached
  63. 1200 IF LEN(A$)<128 AND NOT EOF(1) THEN GET#1: A$=A$+REC$
  64.      C=ASC(A$)
  65.      IF C=0 THEN QUOT=0: GOTO 1110
  66.      L=2
  67.      IF C=34 THEN QUOT=NOT QUOT
  68.      IF QUOT THEN 1230
  69.      IF C=15 OR C>249 THEN L=3 _
  70.      ELSE IF C=11 OR C=12 OR C=28 THEN L=4 _
  71.      ELSE IF C=29 THEN L=6 _
  72.      ELSE IF C=31 THEN L=10
  73. 1230 A$=MID$(A$,L)
  74.      GOTO 1200
  75.  
  76. '    extract and save line number for cross reference
  77. 1240 LNR!=CVI(MID$(A$,2,2))
  78.      A$=MID$(A$,4)
  79.      IF LNR!<0 THEN LNR!=LNR!+65536!
  80.      GOSUB 1260
  81.      GOTO 1130
  82.  
  83. 1260 IF LINS=0 THEN LINS=1: LN!(1)=LNR!: RETURN
  84.      GOSUB 1290
  85.      IF FOUND THEN RETURN
  86.      IF LINS>1000 THEN PRINT: PRINT"Too many lines referenced to handle": END
  87.      FOR X=LINS TO WH1 STEP -1
  88.         SWAP LN!(X),LN!(X+1)
  89.      NEXT
  90.      LN!(WH1)=LNR!
  91.      LINS=LINS+1
  92. 1290 FOUND=0
  93.      TOP=LINS+1
  94.      BOT=1
  95.      OLD=-1
  96.      WH1=LINS\2+1
  97.      LNF!=LN!(WH1)
  98.      WHILE OLD<>WH1 AND LNR!<>LNF!
  99.         IF LNR!<LNF! THEN TOP=WH1 ELSE BOT=WH1
  100.         OLD=WH1
  101.         WH1=(TOP+BOT)\2
  102.         LNF!=LN!(WH1)
  103.      WEND
  104.      IF LNR!=LNF! THEN FOUND=-1 ELSE IF LNR!>LNF! THEN WH1=WH1+1
  105.      RETURN
  106.  
  107. 1340 CLOSE
  108.      PRINT: PRINT
  109.      PRINT"Primary analysis done, beginning secondary analysis and output."
  110.      LOCATE 8,1
  111.      PRINT"Scanning line";
  112.      FLAG=0
  113.      LN=1
  114.      OPEN"I",1,FIL$+"ASC"
  115.      OPEN"O",2,FIL$+"BCS"
  116.      WHILE NOT EOF(1) AND NOT FLAG
  117.         LINE INPUT#1,A$
  118.         L!=VAL(A$)
  119.         LOCATE 8,14
  120.         PRINT L!;
  121. 1510    IF L!=LN!(LN) THEN GOSUB 1620 _
  122.         ELSE IF L!<LN!(LN) THEN GOSUB 1600: GOTO 1530 _
  123.         ELSE LN=LN+1: IF LN>LINS THEN GOSUB 1600: FLAG=-1 ELSE 1510
  124.         LN=LN+1
  125.         IF LN>LINS THEN FLAG=-1
  126. 1530 WEND
  127.      WHILE NOT EOF(1)
  128.         LINE INPUT#1,A$
  129.         LOCATE 8,14
  130.         PRINT VAL(A$);
  131.         GOSUB 1600
  132.      WEND
  133.      IF LA$<>"" THEN GOSUB 1620
  134.      IF A$<>"" THEN LA$=A$: GOSUB 1620
  135.      CLOSE
  136.      PRINT: PRINT
  137.      PRINT"File comblined:";BYT;"bytes saved."
  138.      PRINT"Output file is ";FIL$;"BCS."
  139.      PRINT
  140.      PRINT"Want to do another? ";
  141.      LOCATE ,,1
  142.      I$=INPUT$(1)
  143.      IF I$="Y" OR I$="y" THEN 10
  144.      END
  145.  
  146. 1600 IF LA$="" THEN LA$=A$: A$="": RETURN
  147.      L=LEN(STR$(VAL(A$)))+1
  148.      IF INSTR(LA$,"REM") OR INSTR(LA$,"'") THEN 1620
  149.      IF INSTR(LA$,"DATA ") OR INSTR(LA$,"IF ") THEN 1620
  150.      IF LEN(LA$)+LEN(A$)-L>230 THEN 1620
  151.      A$=MID$(A$,L)
  152.      IF LEFT$(A$,1)="'" THEN LA$=LA$+A$: BYT=BYT+5 _
  153.      ELSE LA$=LA$+":"+A$: BYT=BYT+4
  154.      A$=""
  155.      RETURN
  156.  
  157. 1620 IF LA$<>"" THEN PRINT#2,LA$
  158.      LA$=A$
  159.      A$=""
  160.      RETURN
  161.